home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / win / tclWinPipe.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  65.2 KB  |  2,405 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclWinPipe.c --
  3.  *
  4.  *    This file implements the Windows-specific exec pipeline functions,
  5.  *    the "pipe" channel driver, and the "pid" Tcl command.
  6.  *
  7.  * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclWinPipe.c 1.44 97/08/05 11:46:12
  13.  */
  14.  
  15. #include "tclWinInt.h"
  16.  
  17. #include <dos.h>
  18. #include <fcntl.h>
  19. #include <io.h>
  20. #include <sys/stat.h>
  21.  
  22. /*
  23.  * The following variable is used to tell whether this module has been
  24.  * initialized.
  25.  */
  26.  
  27. static int initialized = 0;
  28.  
  29. /*
  30.  * The following defines identify the various types of applications that 
  31.  * run under windows.  There is special case code for the various types.
  32.  */
  33.  
  34. #define APPL_NONE    0
  35. #define APPL_DOS    1
  36. #define APPL_WIN3X    2
  37. #define APPL_WIN32    3
  38.  
  39. /*
  40.  * The following constants and structures are used to encapsulate the state
  41.  * of various types of files used in a pipeline.
  42.  */
  43.  
  44. #define WIN32S_PIPE 1        /* Win32s emulated pipe. */
  45. #define WIN32S_TMPFILE 2    /* Win32s emulated temporary file. */
  46. #define WIN_FILE 3        /* Basic Win32 file. */
  47.  
  48. /*
  49.  * This structure encapsulates the common state associated with all file
  50.  * types used in a pipeline.
  51.  */
  52.  
  53. typedef struct WinFile {
  54.     int type;            /* One of the file types defined above. */
  55.     HANDLE handle;        /* Open file handle. */
  56. } WinFile;
  57.  
  58. /*
  59.  * The following structure is used to keep track of temporary files under
  60.  * Win32s and delete the disk file when the open handle is closed.
  61.  * The type field will be WIN32S_TMPFILE.
  62.  */
  63.  
  64. typedef struct TmpFile {
  65.     WinFile file;        /* Common part. */
  66.     char name[MAX_PATH];    /* Name of temp file. */
  67. } TmpFile;
  68.  
  69. /*
  70.  * The following structure represents a synchronous pipe under Win32s.
  71.  * The type field will be WIN32S_PIPE.  The handle field will refer to
  72.  * an open file when Tcl is reading from the "pipe", otherwise it is
  73.  * INVALID_HANDLE_VALUE.
  74.  */
  75.  
  76. typedef struct WinPipe {
  77.     WinFile file;        /* Common part. */
  78.     struct WinPipe *otherPtr;    /* Pointer to the WinPipe structure that
  79.                  * corresponds to the other end of this 
  80.                  * pipe. */
  81.     char *fileName;        /* The name of the staging file that gets 
  82.                  * the data written to this pipe.  Malloc'd.
  83.                  * and shared by both ends of the pipe.  Only
  84.                  * when both ends are freed will fileName be
  85.                  * freed and the file it refers to deleted. */
  86. } WinPipe;
  87.  
  88. /*
  89.  * This list is used to map from pids to process handles.
  90.  */
  91.  
  92. typedef struct ProcInfo {
  93.     HANDLE hProcess;
  94.     DWORD dwProcessId;
  95.     struct ProcInfo *nextPtr;
  96. } ProcInfo;
  97.  
  98. static ProcInfo *procList;
  99.  
  100. /*
  101.  * State flags used in the PipeInfo structure below.
  102.  */
  103.  
  104. #define PIPE_PENDING    (1<<0)    /* Message is pending in the queue. */
  105. #define PIPE_ASYNC    (1<<1)    /* Channel is non-blocking. */
  106.  
  107. /*
  108.  * This structure describes per-instance data for a pipe based channel.
  109.  */
  110.  
  111. typedef struct PipeInfo {
  112.     Tcl_Channel channel;    /* Pointer to channel structure. */
  113.     int validMask;        /* OR'ed combination of TCL_READABLE,
  114.                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  115.                  * which operations are valid on the file. */
  116.     int watchMask;        /* OR'ed combination of TCL_READABLE,
  117.                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  118.                  * which events should be reported. */
  119.     int flags;            /* State flags, see above for a list. */
  120.     TclFile readFile;        /* Output from pipe. */
  121.     TclFile writeFile;        /* Input from pipe. */
  122.     TclFile errorFile;        /* Error output from pipe. */
  123.     int numPids;        /* Number of processes attached to pipe. */
  124.     Tcl_Pid *pidPtr;        /* Pids of attached processes. */
  125.     struct PipeInfo *nextPtr;    /* Pointer to next registered pipe. */
  126. } PipeInfo;
  127.  
  128. /*
  129.  * The following pointer refers to the head of the list of pipes
  130.  * that are being watched for file events.
  131.  */
  132.  
  133. static PipeInfo *firstPipePtr;
  134.  
  135. /*
  136.  * The following structure is what is added to the Tcl event queue when
  137.  * pipe events are generated.
  138.  */
  139.  
  140. typedef struct PipeEvent {
  141.     Tcl_Event header;        /* Information that is standard for
  142.                  * all events. */
  143.     PipeInfo *infoPtr;        /* Pointer to pipe info structure.  Note
  144.                  * that we still have to verify that the
  145.                  * pipe exists before dereferencing this
  146.                  * pointer. */
  147. } PipeEvent;
  148.  
  149. /*
  150.  * Declarations for functions used only in this file.
  151.  */
  152.  
  153. static int    ApplicationType(Tcl_Interp *interp, const char *fileName,
  154.             char *fullName);
  155. static void    BuildCommandLine(int argc, char **argv, Tcl_DString *linePtr);
  156. static void    CopyChannel(HANDLE dst, HANDLE src);
  157. static BOOL    HasConsole(void);
  158. static TclFile    MakeFile(HANDLE handle);
  159. static char *    MakeTempFile(Tcl_DString *namePtr);
  160. static int    PipeBlockModeProc(ClientData instanceData, int mode);
  161. static void    PipeCheckProc _ANSI_ARGS_((ClientData clientData,
  162.             int flags));
  163. static int    PipeCloseProc(ClientData instanceData, Tcl_Interp *interp);
  164. static int    PipeEventProc(Tcl_Event *evPtr, int flags);
  165. static void    PipeExitHandler(ClientData clientData);
  166. static int    PipeGetHandleProc(ClientData instanceData, int direction,
  167.             ClientData *handlePtr);
  168. static void    PipeInit(void);
  169. static int    PipeInputProc(ClientData instanceData, char *buf, int toRead,
  170.             int *errorCode);
  171. static int    PipeOutputProc(ClientData instanceData, char *buf, int toWrite,
  172.             int *errorCode);
  173. static void    PipeWatchProc(ClientData instanceData, int mask);
  174. static void    PipeSetupProc _ANSI_ARGS_((ClientData clientData,
  175.             int flags));
  176.  
  177. /*
  178.  * This structure describes the channel type structure for command pipe
  179.  * based IO.
  180.  */
  181.  
  182. static Tcl_ChannelType pipeChannelType = {
  183.     "pipe",            /* Type name. */
  184.     PipeBlockModeProc,        /* Set blocking or non-blocking mode.*/
  185.     PipeCloseProc,        /* Close proc. */
  186.     PipeInputProc,        /* Input proc. */
  187.     PipeOutputProc,        /* Output proc. */
  188.     NULL,            /* Seek proc. */
  189.     NULL,            /* Set option proc. */
  190.     NULL,            /* Get option proc. */
  191.     PipeWatchProc,        /* Set up notifier to watch the channel. */
  192.     PipeGetHandleProc,        /* Get an OS handle from channel. */
  193. };
  194.  
  195. /*
  196.  *----------------------------------------------------------------------
  197.  *
  198.  * PipeInit --
  199.  *
  200.  *    This function initializes the static variables for this file.
  201.  *
  202.  * Results:
  203.  *    None.
  204.  *
  205.  * Side effects:
  206.  *    Creates a new event source.
  207.  *
  208.  *----------------------------------------------------------------------
  209.  */
  210.  
  211. static void
  212. PipeInit()
  213. {
  214.     initialized = 1;
  215.     firstPipePtr = NULL;
  216.     procList = NULL;
  217.     Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
  218.     Tcl_CreateExitHandler(PipeExitHandler, NULL);
  219. }
  220.  
  221. /*
  222.  *----------------------------------------------------------------------
  223.  *
  224.  * PipeExitHandler --
  225.  *
  226.  *    This function is called to cleanup the pipe module before
  227.  *    Tcl is unloaded.
  228.  *
  229.  * Results:
  230.  *    None.
  231.  *
  232.  * Side effects:
  233.  *    Removes the pipe event source.
  234.  *
  235.  *----------------------------------------------------------------------
  236.  */
  237.  
  238. static void
  239. PipeExitHandler(clientData)
  240.     ClientData clientData;    /* Old window proc */
  241. {
  242.     Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
  243.     initialized = 0;
  244. }
  245.  
  246. /*
  247.  *----------------------------------------------------------------------
  248.  *
  249.  * PipeSetupProc --
  250.  *
  251.  *    This procedure is invoked before Tcl_DoOneEvent blocks waiting
  252.  *    for an event.
  253.  *
  254.  * Results:
  255.  *    None.
  256.  *
  257.  * Side effects:
  258.  *    Adjusts the block time if needed.
  259.  *
  260.  *----------------------------------------------------------------------
  261.  */
  262.  
  263. void
  264. PipeSetupProc(data, flags)
  265.     ClientData data;        /* Not used. */
  266.     int flags;            /* Event flags as passed to Tcl_DoOneEvent. */
  267. {
  268.     PipeInfo *infoPtr;
  269.     Tcl_Time blockTime = { 0, 0 };
  270.  
  271.     if (!(flags & TCL_FILE_EVENTS)) {
  272.     return;
  273.     }
  274.     
  275.     /*
  276.      * Check to see if there is a watched pipe.  If so, poll.
  277.      */
  278.  
  279.     for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  280.     if (infoPtr->watchMask) {
  281.         Tcl_SetMaxBlockTime(&blockTime);
  282.         break;
  283.     }
  284.     }
  285. }
  286.  
  287. /*
  288.  *----------------------------------------------------------------------
  289.  *
  290.  * PipeCheckProc --
  291.  *
  292.  *    This procedure is called by Tcl_DoOneEvent to check the pipe
  293.  *    event source for events. 
  294.  *
  295.  * Results:
  296.  *    None.
  297.  *
  298.  * Side effects:
  299.  *    May queue an event.
  300.  *
  301.  *----------------------------------------------------------------------
  302.  */
  303.  
  304. static void
  305. PipeCheckProc(data, flags)
  306.     ClientData data;        /* Not used. */
  307.     int flags;            /* Event flags as passed to Tcl_DoOneEvent. */
  308. {
  309.     PipeInfo *infoPtr;
  310.     PipeEvent *evPtr;
  311.  
  312.     if (!(flags & TCL_FILE_EVENTS)) {
  313.     return;
  314.     }
  315.     
  316.     /*
  317.      * Queue events for any watched pipes that don't already have events
  318.      * queued.
  319.      */
  320.  
  321.     for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  322.     if (infoPtr->watchMask && !(infoPtr->flags & PIPE_PENDING)) {
  323.         infoPtr->flags |= PIPE_PENDING;
  324.         evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
  325.         evPtr->header.proc = PipeEventProc;
  326.         evPtr->infoPtr = infoPtr;
  327.         Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
  328.     }
  329.     }
  330. }
  331.  
  332. /*
  333.  *----------------------------------------------------------------------
  334.  *
  335.  * MakeFile --
  336.  *
  337.  *    This function constructs a new TclFile from a given data and
  338.  *    type value.
  339.  *
  340.  * Results:
  341.  *    Returns a newly allocated WinFile as a TclFile.
  342.  *
  343.  * Side effects:
  344.  *    None.
  345.  *
  346.  *----------------------------------------------------------------------
  347.  */
  348.  
  349. static TclFile
  350. MakeFile(handle)
  351.     HANDLE handle;        /* Type-specific data. */
  352. {
  353.     WinFile *filePtr;
  354.  
  355.     filePtr = (WinFile *) ckalloc(sizeof(WinFile));
  356.     filePtr->type = WIN_FILE;
  357.     filePtr->handle = handle;
  358.  
  359.     return (TclFile)filePtr;
  360. }
  361.  
  362. /*
  363.  *----------------------------------------------------------------------
  364.  *
  365.  * TclpMakeFile --
  366.  *
  367.  *    Make a TclFile from a channel.
  368.  *
  369.  * Results:
  370.  *    Returns a new TclFile or NULL on failure.
  371.  *
  372.  * Side effects:
  373.  *    None.
  374.  *
  375.  *----------------------------------------------------------------------
  376.  */
  377.  
  378. TclFile
  379. TclpMakeFile(channel, direction)
  380.     Tcl_Channel channel;    /* Channel to get file from. */
  381.     int direction;        /* Either TCL_READABLE or TCL_WRITABLE. */
  382. {
  383.     HANDLE handle;
  384.  
  385.     if (Tcl_GetChannelHandle(channel, direction, 
  386.         (ClientData *) &handle) == TCL_OK) {
  387.     return MakeFile(handle);
  388.     } else {
  389.     return (TclFile) NULL;
  390.     }
  391. }
  392.  
  393. /*
  394.  *----------------------------------------------------------------------
  395.  *
  396.  * TclpCreateTempFile --
  397.  *
  398.  *    This function opens a unique file with the property that it
  399.  *    will be deleted when its file handle is closed.  The temporary
  400.  *    file is created in the system temporary directory.
  401.  *
  402.  * Results:
  403.  *    Returns a valid TclFile, or NULL on failure.
  404.  *
  405.  * Side effects:
  406.  *    Creates a new temporary file.
  407.  *
  408.  *----------------------------------------------------------------------
  409.  */
  410.  
  411. TclFile
  412. TclpCreateTempFile(contents, namePtr)
  413.     char *contents;        /* String to write into temp file, or NULL. */
  414.     Tcl_DString *namePtr;    /* If non-NULL, pointer to initialized 
  415.                  * DString that is filled with the name of 
  416.                  * the temp file that was created. */
  417. {
  418.     char name[MAX_PATH];
  419.     HANDLE handle;
  420.  
  421.     if ((GetTempPath(MAX_PATH, name) == 0) ||
  422.         (GetTempFileName(name, "TCL", 0, name) == 0)) {
  423.     return NULL;
  424.     }
  425.  
  426.     handle = CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, NULL,
  427.         CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE,
  428.         NULL);
  429.     if (handle == INVALID_HANDLE_VALUE) {
  430.     goto error;
  431.     }
  432.  
  433.     /*
  434.      * Write the file out, doing line translations on the way.
  435.      */
  436.  
  437.     if (contents != NULL) {
  438.     DWORD result, length;
  439.     char *p;
  440.     
  441.     for (p = contents; *p != '\0'; p++) {
  442.         if (*p == '\n') {
  443.         length = p - contents;
  444.         if (length > 0) {
  445.             if (!WriteFile(handle, contents, length, &result, NULL)) {
  446.             goto error;
  447.             }
  448.         }
  449.         if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
  450.             goto error;
  451.         }
  452.         contents = p+1;
  453.         }
  454.     }
  455.     length = p - contents;
  456.     if (length > 0) {
  457.         if (!WriteFile(handle, contents, length, &result, NULL)) {
  458.         goto error;
  459.         }
  460.     }
  461.     }
  462.  
  463.     if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
  464.     goto error;
  465.     }
  466.  
  467.     if (namePtr != NULL) {
  468.         Tcl_DStringAppend(namePtr, name, -1);
  469.     }
  470.  
  471.     /*
  472.      * Under Win32s a file created with FILE_FLAG_DELETE_ON_CLOSE won't
  473.      * actually be deleted when it is closed, so we have to do it ourselves.
  474.      */
  475.  
  476.     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
  477.     TmpFile *tmpFilePtr = (TmpFile *) ckalloc(sizeof(TmpFile));
  478.     tmpFilePtr->file.type = WIN32S_TMPFILE;
  479.     tmpFilePtr->file.handle = handle;
  480.     strcpy(tmpFilePtr->name, name);
  481.     return (TclFile)tmpFilePtr;
  482.     } else {
  483.     return MakeFile(handle);
  484.     }
  485.  
  486.   error:
  487.     TclWinConvertError(GetLastError());
  488.     CloseHandle(handle);
  489.     DeleteFile(name);
  490.     return NULL;
  491. }
  492.  
  493. /*
  494.  *----------------------------------------------------------------------
  495.  *
  496.  * TclpOpenFile --
  497.  *
  498.  *    This function opens files for use in a pipeline.
  499.  *
  500.  * Results:
  501.  *    Returns a newly allocated TclFile structure containing the
  502.  *    file handle.
  503.  *
  504.  * Side effects:
  505.  *    None.
  506.  *
  507.  *----------------------------------------------------------------------
  508.  */
  509.  
  510. TclFile
  511. TclpOpenFile(path, mode)
  512.     char *path;
  513.     int mode;
  514. {
  515.     HANDLE handle;
  516.     DWORD accessMode, createMode, shareMode, flags;
  517.     SECURITY_ATTRIBUTES sec;
  518.  
  519.     /*
  520.      * Map the access bits to the NT access mode.
  521.      */
  522.  
  523.     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
  524.     case O_RDONLY:
  525.         accessMode = GENERIC_READ;
  526.         break;
  527.     case O_WRONLY:
  528.         accessMode = GENERIC_WRITE;
  529.         break;
  530.     case O_RDWR:
  531.         accessMode = (GENERIC_READ | GENERIC_WRITE);
  532.         break;
  533.     default:
  534.         TclWinConvertError(ERROR_INVALID_FUNCTION);
  535.         return NULL;
  536.     }
  537.  
  538.     /*
  539.      * Map the creation flags to the NT create mode.
  540.      */
  541.  
  542.     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
  543.     case (O_CREAT | O_EXCL):
  544.     case (O_CREAT | O_EXCL | O_TRUNC):
  545.         createMode = CREATE_NEW;
  546.         break;
  547.     case (O_CREAT | O_TRUNC):
  548.         createMode = CREATE_ALWAYS;
  549.         break;
  550.     case O_CREAT:
  551.         createMode = OPEN_ALWAYS;
  552.         break;
  553.     case O_TRUNC:
  554.     case (O_TRUNC | O_EXCL):
  555.         createMode = TRUNCATE_EXISTING;
  556.         break;
  557.     default:
  558.         createMode = OPEN_EXISTING;
  559.         break;
  560.     }
  561.  
  562.     /*
  563.      * If the file is not being created, use the existing file attributes.
  564.      */
  565.  
  566.     flags = 0;
  567.     if (!(mode & O_CREAT)) {
  568.     flags = GetFileAttributes(path);
  569.     if (flags == 0xFFFFFFFF) {
  570.         flags = 0;
  571.     }
  572.     }
  573.  
  574.     /*
  575.      * Set up the security attributes so this file is not inherited by
  576.      * child processes.
  577.      */
  578.  
  579.     sec.nLength = sizeof(sec);
  580.     sec.lpSecurityDescriptor = NULL;
  581.     sec.bInheritHandle = 0;
  582.  
  583.     /*
  584.      * Set up the file sharing mode.  We want to allow simultaneous access.
  585.      */
  586.  
  587.     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
  588.  
  589.     /*
  590.      * Now we get to create the file.
  591.      */
  592.  
  593.     handle = CreateFile(path, accessMode, shareMode, &sec, createMode, flags,
  594.             (HANDLE) NULL);
  595.     if (handle == INVALID_HANDLE_VALUE) {
  596.     DWORD err = GetLastError();
  597.     if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
  598.         err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
  599.     }
  600.         TclWinConvertError(err);
  601.         return NULL;
  602.     }
  603.  
  604.     /*
  605.      * Seek to the end of file if we are writing.
  606.      */
  607.  
  608.     if (mode & O_WRONLY) {
  609.     SetFilePointer(handle, 0, NULL, FILE_END);
  610.     }
  611.  
  612.     return MakeFile(handle);
  613. }
  614.  
  615. /*
  616.  *----------------------------------------------------------------------
  617.  *
  618.  * TclpCreatePipe --
  619.  *
  620.  *      Creates an anonymous pipe.  Under Win32s, creates a temp file
  621.  *    that is used to simulate a pipe.
  622.  *
  623.  * Results:
  624.  *      Returns 1 on success, 0 on failure. 
  625.  *
  626.  * Side effects:
  627.  *      Creates a pipe.
  628.  *
  629.  *----------------------------------------------------------------------
  630.  */
  631.  
  632. int
  633. TclpCreatePipe(readPipe, writePipe)
  634.     TclFile *readPipe;    /* Location to store file handle for
  635.                  * read side of pipe. */
  636.     TclFile *writePipe;    /* Location to store file handle for
  637.                  * write side of pipe. */
  638. {
  639.     HANDLE readHandle, writeHandle;
  640.  
  641.     if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
  642.     *readPipe = MakeFile(readHandle);
  643.     *writePipe = MakeFile(writeHandle);
  644.     return 1;
  645.     }
  646.  
  647.     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
  648.     WinPipe *readPipePtr, *writePipePtr;
  649.     char buf[MAX_PATH];
  650.  
  651.     if ((GetTempPath(MAX_PATH, buf) != 0)
  652.             && (GetTempFileName(buf, "TCL", 0, buf) != 0)) {
  653.  
  654.         readPipePtr = (WinPipe *) ckalloc(sizeof(WinPipe));
  655.         writePipePtr = (WinPipe *) ckalloc(sizeof(WinPipe));
  656.  
  657.         readPipePtr->file.type = WIN32S_PIPE;
  658.         readPipePtr->otherPtr = writePipePtr;
  659.         readPipePtr->fileName = strcpy(ckalloc(strlen(buf) + 1), buf);
  660.         readPipePtr->file.handle = INVALID_HANDLE_VALUE;
  661.         writePipePtr->file.type = WIN32S_PIPE;
  662.         writePipePtr->otherPtr = readPipePtr;
  663.         writePipePtr->fileName = readPipePtr->fileName;
  664.         writePipePtr->file.handle = INVALID_HANDLE_VALUE;
  665.  
  666.         *readPipe = (TclFile)readPipePtr;
  667.         *writePipe = (TclFile)writePipePtr;
  668.  
  669.         return 1;
  670.     }
  671.     }
  672.  
  673.     TclWinConvertError(GetLastError());
  674.     return 0;
  675. }
  676.  
  677. /*
  678.  *----------------------------------------------------------------------
  679.  *
  680.  * TclpCloseFile --
  681.  *
  682.  *    Closes a pipeline file handle.  These handles are created by
  683.  *    TclpOpenFile, TclpCreatePipe, or TclpMakeFile.
  684.  *
  685.  * Results:
  686.  *    0 on success, -1 on failure.
  687.  *
  688.  * Side effects:
  689.  *    The file is closed and deallocated.
  690.  *
  691.  *----------------------------------------------------------------------
  692.  */
  693.  
  694. int
  695. TclpCloseFile(file)
  696.     TclFile file;    /* The file to close. */
  697. {
  698.     WinFile *filePtr = (WinFile *) file;
  699.     WinPipe *pipePtr;
  700.  
  701.     switch (filePtr->type) {
  702.     case WIN_FILE:
  703.     case WIN32S_TMPFILE:
  704.         if (CloseHandle(filePtr->handle) == FALSE) {
  705.         TclWinConvertError(GetLastError());
  706.         ckfree((char *) filePtr);
  707.         return -1;
  708.         }
  709.         /*
  710.          * Simulate deleting the file on close for Win32s.
  711.          */
  712.  
  713.         if (filePtr->type == WIN32S_TMPFILE) {
  714.         DeleteFile(((TmpFile*)filePtr)->name);
  715.         }
  716.         break;
  717.  
  718.     case WIN32S_PIPE:
  719.         pipePtr = (WinPipe *) file;
  720.  
  721.         if (pipePtr->otherPtr != NULL) {
  722.         pipePtr->otherPtr->otherPtr = NULL;
  723.         } else {
  724.         if (pipePtr->file.handle != INVALID_HANDLE_VALUE) {
  725.             CloseHandle(pipePtr->file.handle);
  726.         }
  727.         DeleteFile(pipePtr->fileName);
  728.         ckfree((char *) pipePtr->fileName);
  729.         }
  730.         break;
  731.  
  732.     default:
  733.         panic("Tcl_CloseFile: unexpected file type");
  734.     }
  735.  
  736.     ckfree((char *) filePtr);
  737.     return 0;
  738. }
  739.  
  740. /*
  741.  *--------------------------------------------------------------------------
  742.  *
  743.  * TclpGetPid --
  744.  *
  745.  *    Given a HANDLE to a child process, return the process id for that
  746.  *    child process.
  747.  *
  748.  * Results:
  749.  *    Returns the process id for the child process.  If the pid was not 
  750.  *    known by Tcl, either because the pid was not created by Tcl or the 
  751.  *    child process has already been reaped, -1 is returned.
  752.  *
  753.  * Side effects:
  754.  *    None.
  755.  *
  756.  *--------------------------------------------------------------------------
  757.  */
  758.  
  759. unsigned long
  760. TclpGetPid(pid)
  761.     Tcl_Pid pid;        /* The HANDLE of the child process. */
  762. {
  763.     ProcInfo *infoPtr;
  764.     
  765.     for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  766.     if (infoPtr->hProcess == (HANDLE) pid) {
  767.         return infoPtr->dwProcessId;
  768.     }
  769.     }
  770.     return (unsigned long) -1;
  771. }
  772.  
  773. /*
  774.  *----------------------------------------------------------------------
  775.  *
  776.  * TclpCreateProcess --
  777.  *
  778.  *    Create a child process that has the specified files as its 
  779.  *    standard input, output, and error.  The child process runs
  780.  *    synchronously under Win32s and asynchronously under Windows NT
  781.  *    and Windows 95, and runs with the same environment variables
  782.  *    as the creating process.
  783.  *
  784.  *    The complete Windows search path is searched to find the specified 
  785.  *    executable.  If an executable by the given name is not found, 
  786.  *    automatically tries appending ".com", ".exe", and ".bat" to the 
  787.  *    executable name.
  788.  *
  789.  * Results:
  790.  *    The return value is TCL_ERROR and an error message is left in
  791.  *    interp->result if there was a problem creating the child 
  792.  *    process.  Otherwise, the return value is TCL_OK and *pidPtr is
  793.  *    filled with the process id of the child process.
  794.  * 
  795.  * Side effects:
  796.  *    A process is created.
  797.  *    
  798.  *----------------------------------------------------------------------
  799.  */
  800.  
  801. int
  802. TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, 
  803.     pidPtr)
  804.     Tcl_Interp *interp;        /* Interpreter in which to leave errors that
  805.                  * occurred when creating the child process.
  806.                  * Error messages from the child process
  807.                  * itself are sent to errorFile. */
  808.     int argc;            /* Number of arguments in following array. */
  809.     char **argv;        /* Array of argument strings.  argv[0]
  810.                  * contains the name of the executable
  811.                  * converted to native format (using the
  812.                  * Tcl_TranslateFileName call).  Additional
  813.                  * arguments have not been converted. */
  814.     TclFile inputFile;        /* If non-NULL, gives the file to use as
  815.                  * input for the child process.  If inputFile
  816.                  * file is not readable or is NULL, the child
  817.                  * will receive no standard input. */
  818.     TclFile outputFile;        /* If non-NULL, gives the file that
  819.                  * receives output from the child process.  If
  820.                  * outputFile file is not writeable or is
  821.                  * NULL, output from the child will be
  822.                  * discarded. */
  823.     TclFile errorFile;        /* If non-NULL, gives the file that
  824.                  * receives errors from the child process.  If
  825.                  * errorFile file is not writeable or is NULL,
  826.                  * errors from the child will be discarded.
  827.                  * errorFile may be the same as outputFile. */
  828.     Tcl_Pid *pidPtr;        /* If this procedure is successful, pidPtr
  829.                  * is filled with the process id of the child
  830.                  * process. */
  831. {
  832.     int result, applType, createFlags;
  833.     Tcl_DString cmdLine;
  834.     STARTUPINFO startInfo;
  835.     PROCESS_INFORMATION procInfo;
  836.     SECURITY_ATTRIBUTES secAtts;
  837.     HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
  838.     char execPath[MAX_PATH];
  839.     char *originalName;
  840.     WinFile *filePtr;
  841.  
  842.     applType = ApplicationType(interp, argv[0], execPath);
  843.     if (applType == APPL_NONE) {
  844.     return TCL_ERROR;
  845.     }
  846.     originalName = argv[0];
  847.     argv[0] = execPath;
  848.  
  849.     result = TCL_ERROR;
  850.     Tcl_DStringInit(&cmdLine);
  851.  
  852.     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
  853.     /*
  854.      * Under Win32s, there are no pipes.  In order to simulate pipe
  855.      * behavior, the child processes are run synchronously and their
  856.      * I/O is redirected from/to temporary files before the next 
  857.      * stage of the pipeline is started.
  858.      */
  859.  
  860.     MSG msg;
  861.     DWORD status;
  862.     DWORD args[4];
  863.     void *trans[5];
  864.     char *inputFileName, *outputFileName;
  865.     Tcl_DString inputTempFile, outputTempFile;
  866.  
  867.     BuildCommandLine(argc, argv, &cmdLine);
  868.  
  869.     ZeroMemory(&startInfo, sizeof(startInfo));
  870.     startInfo.cb = sizeof(startInfo);
  871.  
  872.     Tcl_DStringInit(&inputTempFile);
  873.     Tcl_DStringInit(&outputTempFile);
  874.     outputHandle = INVALID_HANDLE_VALUE;
  875.  
  876.     inputFileName = NULL;
  877.     outputFileName = NULL;
  878.     if (inputFile != NULL) {
  879.         filePtr = (WinFile *) inputFile;
  880.         switch (filePtr->type) {
  881.         case WIN_FILE:
  882.         case WIN32S_TMPFILE: {
  883.             h = INVALID_HANDLE_VALUE;
  884.             inputFileName = MakeTempFile(&inputTempFile);
  885.             if (inputFileName != NULL) {
  886.             h = CreateFile(inputFileName, GENERIC_WRITE, 0, 
  887.                 NULL, CREATE_ALWAYS, 0, NULL);
  888.             }
  889.             if (h == INVALID_HANDLE_VALUE) {
  890.             Tcl_AppendResult(interp, "couldn't duplicate input handle: ", 
  891.                 Tcl_PosixError(interp), (char *) NULL);
  892.             goto end32s;
  893.             }
  894.             CopyChannel(h, filePtr->handle);
  895.             CloseHandle(h);
  896.             break;
  897.         }
  898.         case WIN32S_PIPE: {
  899.             inputFileName = ((WinPipe*)inputFile)->fileName;
  900.             break;
  901.         }
  902.         }
  903.     }
  904.     if (inputFileName == NULL) {
  905.         inputFileName = "nul";
  906.     }
  907.     if (outputFile != NULL) {
  908.         filePtr = (WinFile *)outputFile;
  909.         if (filePtr->type == WIN_FILE) {
  910.         outputFileName = MakeTempFile(&outputTempFile);
  911.         if (outputFileName == NULL) {
  912.             Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
  913.                 Tcl_PosixError(interp), (char *) NULL);
  914.             goto end32s;
  915.         }
  916.         outputHandle = filePtr->handle;
  917.         } else if (filePtr->type == WIN32S_PIPE) {
  918.         outputFileName = ((WinPipe*)outputFile)->fileName;
  919.         }
  920.     }
  921.     if (outputFileName == NULL) {
  922.         outputFileName = "nul";
  923.     }
  924.  
  925.     if (applType == APPL_DOS) {
  926.         args[0] = (DWORD) Tcl_DStringValue(&cmdLine);
  927.         args[1] = (DWORD) inputFileName;
  928.         args[2] = (DWORD) outputFileName;
  929.         trans[0] = &args[0];
  930.         trans[1] = &args[1];
  931.         trans[2] = &args[2];
  932.         trans[3] = NULL;
  933.         if (TclWinSynchSpawn(args, 0, trans, pidPtr) != 0) {
  934.         result = TCL_OK;
  935.         }
  936.     } else if (applType == APPL_WIN3X) {
  937.         args[0] = (DWORD) Tcl_DStringValue(&cmdLine);
  938.         trans[0] = &args[0];
  939.         trans[1] = NULL;
  940.         if (TclWinSynchSpawn(args, 1, trans, pidPtr) != 0) {
  941.         result = TCL_OK;
  942.         }
  943.     } else {
  944.         if (CreateProcess(NULL, Tcl_DStringValue(&cmdLine), NULL, NULL, 
  945.             FALSE, DETACHED_PROCESS, NULL, NULL, &startInfo, 
  946.             &procInfo) != 0) {
  947.         CloseHandle(procInfo.hThread);
  948.         while (1) {
  949.             if (GetExitCodeProcess(procInfo.hProcess, &status) == FALSE) {
  950.             break;
  951.             }
  952.             if (status != STILL_ACTIVE) {
  953.             break;
  954.             }
  955.             if (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) == TRUE) {
  956.             TranslateMessage(&msg);
  957.             DispatchMessage(&msg);
  958.             }
  959.         }
  960.         *pidPtr = (Tcl_Pid) procInfo.hProcess;
  961.         if (*pidPtr != 0) {
  962.             ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
  963.             procPtr->hProcess = procInfo.hProcess;
  964.             procPtr->dwProcessId = procInfo.dwProcessId;
  965.             procPtr->nextPtr = procList;
  966.             procList = procPtr;
  967.         }
  968.         result = TCL_OK;
  969.         }
  970.     }
  971.     if (result != TCL_OK) {
  972.         TclWinConvertError(GetLastError());
  973.         Tcl_AppendResult(interp, "couldn't execute \"", originalName,
  974.             "\": ", Tcl_PosixError(interp), (char *) NULL);
  975.     }
  976.  
  977.     end32s:
  978.     if (outputHandle != INVALID_HANDLE_VALUE) {
  979.         /*
  980.          * Now copy stuff from temp file to actual output handle. Don't
  981.          * close outputHandle because it is associated with the output
  982.          * file owned by the caller.
  983.          */
  984.  
  985.         h = CreateFile(outputFileName, GENERIC_READ, 0, NULL, OPEN_ALWAYS,
  986.             0, NULL);
  987.         if (h != INVALID_HANDLE_VALUE) {
  988.         CopyChannel(outputHandle, h);
  989.         }
  990.         CloseHandle(h);
  991.     }
  992.  
  993.     if (inputFileName == Tcl_DStringValue(&inputTempFile)) {
  994.         DeleteFile(inputFileName);
  995.     }
  996.     
  997.     if (outputFileName == Tcl_DStringValue(&outputTempFile)) {
  998.         DeleteFile(outputFileName);
  999.     }
  1000.  
  1001.     Tcl_DStringFree(&inputTempFile);
  1002.     Tcl_DStringFree(&outputTempFile);
  1003.         Tcl_DStringFree(&cmdLine);
  1004.     return result;
  1005.     }
  1006.     hProcess = GetCurrentProcess();
  1007.  
  1008.     /*
  1009.      * STARTF_USESTDHANDLES must be used to pass handles to child process.
  1010.      * Using SetStdHandle() and/or dup2() only works when a console mode 
  1011.      * parent process is spawning an attached console mode child process.
  1012.      */
  1013.  
  1014.     ZeroMemory(&startInfo, sizeof(startInfo));
  1015.     startInfo.cb = sizeof(startInfo);
  1016.     startInfo.dwFlags   = STARTF_USESTDHANDLES;
  1017.     startInfo.hStdInput    = INVALID_HANDLE_VALUE;
  1018.     startInfo.hStdOutput= INVALID_HANDLE_VALUE;
  1019.     startInfo.hStdError = INVALID_HANDLE_VALUE;
  1020.  
  1021.     secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);
  1022.     secAtts.lpSecurityDescriptor = NULL;
  1023.     secAtts.bInheritHandle = TRUE;
  1024.  
  1025.     /*
  1026.      * We have to check the type of each file, since we cannot duplicate 
  1027.      * some file types.  
  1028.      */
  1029.  
  1030.     inputHandle = INVALID_HANDLE_VALUE;
  1031.     if (inputFile != NULL) {
  1032.     filePtr = (WinFile *)inputFile;
  1033.     if (filePtr->type == WIN_FILE) {
  1034.         inputHandle = filePtr->handle;
  1035.     }
  1036.     }
  1037.     outputHandle = INVALID_HANDLE_VALUE;
  1038.     if (outputFile != NULL) {
  1039.     filePtr = (WinFile *)outputFile;
  1040.     if (filePtr->type == WIN_FILE) {
  1041.         outputHandle = filePtr->handle;
  1042.     }
  1043.     }
  1044.     errorHandle = INVALID_HANDLE_VALUE;
  1045.     if (errorFile != NULL) {
  1046.     filePtr = (WinFile *)errorFile;
  1047.     if (filePtr->type == WIN_FILE) {
  1048.         errorHandle = filePtr->handle;
  1049.     }
  1050.     }
  1051.  
  1052.     /*
  1053.      * Duplicate all the handles which will be passed off as stdin, stdout
  1054.      * and stderr of the child process. The duplicate handles are set to
  1055.      * be inheritable, so the child process can use them.
  1056.      */
  1057.  
  1058.     if (inputHandle == INVALID_HANDLE_VALUE) {
  1059.     /* 
  1060.      * If handle was not set, stdin should return immediate EOF.
  1061.      * Under Windows95, some applications (both 16 and 32 bit!) 
  1062.      * cannot read from the NUL device; they read from console
  1063.      * instead.  When running tk, this is fatal because the child 
  1064.      * process would hang forever waiting for EOF from the unmapped 
  1065.      * console window used by the helper application.
  1066.      *
  1067.      * Fortunately, the helper application detects a closed pipe 
  1068.      * as an immediate EOF and can pass that information to the 
  1069.      * child process.
  1070.      */
  1071.  
  1072.     if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {
  1073.         CloseHandle(h);
  1074.     }
  1075.     } else {
  1076.     DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
  1077.         0, TRUE, DUPLICATE_SAME_ACCESS);
  1078.     }
  1079.     if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
  1080.     TclWinConvertError(GetLastError());
  1081.     Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
  1082.         Tcl_PosixError(interp), (char *) NULL);
  1083.     goto end;
  1084.     }
  1085.  
  1086.     if (outputHandle == INVALID_HANDLE_VALUE) {
  1087.     /*
  1088.      * If handle was not set, output should be sent to an infinitely 
  1089.      * deep sink.  Under Windows 95, some 16 bit applications cannot
  1090.      * have stdout redirected to NUL; they send their output to
  1091.      * the console instead.  Some applications, like "more" or "dir /p", 
  1092.      * when outputting multiple pages to the console, also then try and
  1093.      * read from the console to go the next page.  When running tk, this
  1094.      * is fatal because the child process would hang forever waiting
  1095.      * for input from the unmapped console window used by the helper
  1096.      * application.
  1097.      *
  1098.      * Fortunately, the helper application will detect a closed pipe
  1099.      * as a sink.
  1100.      */
  1101.  
  1102.     if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) 
  1103.         && (applType == APPL_DOS)) {
  1104.         if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
  1105.         CloseHandle(h);
  1106.         }
  1107.     } else {
  1108.         startInfo.hStdOutput = CreateFile("NUL:", GENERIC_WRITE, 0,
  1109.             &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
  1110.     }
  1111.     } else {
  1112.     DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 
  1113.         0, TRUE, DUPLICATE_SAME_ACCESS);
  1114.     }
  1115.     if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
  1116.     TclWinConvertError(GetLastError());
  1117.     Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
  1118.         Tcl_PosixError(interp), (char *) NULL);
  1119.     goto end;
  1120.     }
  1121.  
  1122.     if (errorHandle == INVALID_HANDLE_VALUE) {
  1123.     /*
  1124.      * If handle was not set, errors should be sent to an infinitely
  1125.      * deep sink.
  1126.      */
  1127.  
  1128.     startInfo.hStdError = CreateFile("NUL:", GENERIC_WRITE, 0,
  1129.         &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
  1130.     } else {
  1131.     DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 
  1132.         0, TRUE, DUPLICATE_SAME_ACCESS);
  1133.     } 
  1134.     if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
  1135.     TclWinConvertError(GetLastError());
  1136.     Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
  1137.         Tcl_PosixError(interp), (char *) NULL);
  1138.     goto end;
  1139.     }
  1140.     /* 
  1141.      * If we do not have a console window, then we must run DOS and
  1142.      * WIN32 console mode applications as detached processes. This tells
  1143.      * the loader that the child application should not inherit the
  1144.      * console, and that it should not create a new console window for
  1145.      * the child application.  The child application should get its stdio 
  1146.      * from the redirection handles provided by this application, and run
  1147.      * in the background.
  1148.      *
  1149.      * If we are starting a GUI process, they don't automatically get a 
  1150.      * console, so it doesn't matter if they are started as foreground or
  1151.      * detached processes.  The GUI window will still pop up to the
  1152.      * foreground.
  1153.      */
  1154.  
  1155.     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
  1156.     if (HasConsole()) {
  1157.         createFlags = 0;
  1158.     } else if (applType == APPL_DOS) {
  1159.         /*
  1160.          * Under NT, 16-bit DOS applications will not run unless they
  1161.          * can be attached to a console.  If we are running without a
  1162.          * console, run the 16-bit program as an normal process inside
  1163.          * of a hidden console application, and then run that hidden
  1164.          * console as a detached process.
  1165.          */
  1166.  
  1167.         startInfo.wShowWindow = SW_HIDE;
  1168.         startInfo.dwFlags |= STARTF_USESHOWWINDOW;
  1169.         createFlags = CREATE_NEW_CONSOLE;
  1170.         Tcl_DStringAppend(&cmdLine, "cmd.exe /c ", -1);
  1171.     } else {
  1172.         createFlags = DETACHED_PROCESS;
  1173.     } 
  1174.     } else {
  1175.     if (HasConsole()) {
  1176.         createFlags = 0;
  1177.     } else {
  1178.         createFlags = DETACHED_PROCESS;
  1179.     }
  1180.     
  1181.     if (applType == APPL_DOS) {
  1182.         /*
  1183.          * Under Windows 95, 16-bit DOS applications do not work well 
  1184.          * with pipes:
  1185.          *
  1186.          * 1. EOF on a pipe between a detached 16-bit DOS application 
  1187.          * and another application is not seen at the other
  1188.          * end of the pipe, so the listening process blocks forever on 
  1189.          * reads.  This inablity to detect EOF happens when either a 
  1190.          * 16-bit app or the 32-bit app is the listener.  
  1191.          *
  1192.          * 2. If a 16-bit DOS application (detached or not) blocks when 
  1193.          * writing to a pipe, it will never wake up again, and it
  1194.          * eventually brings the whole system down around it.
  1195.          *
  1196.          * The 16-bit application is run as a normal process inside
  1197.          * of a hidden helper console app, and this helper may be run
  1198.          * as a detached process.  If any of the stdio handles is
  1199.          * a pipe, the helper application accumulates information 
  1200.          * into temp files and forwards it to or from the DOS 
  1201.          * application as appropriate.  This means that DOS apps 
  1202.          * must receive EOF from a stdin pipe before they will actually
  1203.          * begin, and must finish generating stdout or stderr before 
  1204.          * the data will be sent to the next stage of the pipe.
  1205.          *
  1206.          * The helper app should be located in the same directory as
  1207.          * the tcl dll.
  1208.          */
  1209.  
  1210.         if (createFlags != 0) {
  1211.         startInfo.wShowWindow = SW_HIDE;
  1212.         startInfo.dwFlags |= STARTF_USESHOWWINDOW;
  1213.         createFlags = CREATE_NEW_CONSOLE;
  1214.         }
  1215.         Tcl_DStringAppend(&cmdLine, "tclpip" STRINGIFY(TCL_MAJOR_VERSION) 
  1216.             STRINGIFY(TCL_MINOR_VERSION) ".dll ", -1);
  1217.     }
  1218.     }
  1219.     
  1220.     /*
  1221.      * cmdLine gets the full command line used to invoke the executable,
  1222.      * including the name of the executable itself.  The command line
  1223.      * arguments in argv[] are stored in cmdLine separated by spaces. 
  1224.      * Special characters in individual arguments from argv[] must be 
  1225.      * quoted when being stored in cmdLine.
  1226.      *
  1227.      * When calling any application, bear in mind that arguments that 
  1228.      * specify a path name are not converted.  If an argument contains 
  1229.      * forward slashes as path separators, it may or may not be 
  1230.      * recognized as a path name, depending on the program.  In general,
  1231.      * most applications accept forward slashes only as option 
  1232.      * delimiters and backslashes only as paths.
  1233.      *
  1234.      * Additionally, when calling a 16-bit dos or windows application, 
  1235.      * all path names must use the short, cryptic, path format (e.g., 
  1236.      * using ab~1.def instead of "a b.default").  
  1237.      */
  1238.  
  1239.     BuildCommandLine(argc, argv, &cmdLine);
  1240.  
  1241.     if (!CreateProcess(NULL, Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, 
  1242.         createFlags, NULL, NULL, &startInfo, &procInfo)) {
  1243.     TclWinConvertError(GetLastError());
  1244.     Tcl_AppendResult(interp, "couldn't execute \"", originalName,
  1245.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  1246.     goto end;
  1247.     }
  1248.  
  1249.     if (applType == APPL_DOS) {
  1250.     WaitForSingleObject(hProcess, 50);
  1251.     }
  1252.  
  1253.     /* 
  1254.      * "When an application spawns a process repeatedly, a new thread 
  1255.      * instance will be created for each process but the previous 
  1256.      * instances may not be cleaned up.  This results in a significant 
  1257.      * virtual memory loss each time the process is spawned.  If there 
  1258.      * is a WaitForInputIdle() call between CreateProcess() and
  1259.      * CloseHandle(), the problem does not occur." PSS ID Number: Q124121
  1260.      */
  1261.  
  1262.     WaitForInputIdle(procInfo.hProcess, 5000);
  1263.     CloseHandle(procInfo.hThread);
  1264.  
  1265.     *pidPtr = (Tcl_Pid) procInfo.hProcess;
  1266.     if (*pidPtr != 0) {
  1267.     ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
  1268.     procPtr->hProcess = procInfo.hProcess;
  1269.     procPtr->dwProcessId = procInfo.dwProcessId;
  1270.     procPtr->nextPtr = procList;
  1271.     procList = procPtr;
  1272.     }
  1273.     result = TCL_OK;
  1274.  
  1275.     end:
  1276.     Tcl_DStringFree(&cmdLine);
  1277.     if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {
  1278.         CloseHandle(startInfo.hStdInput);
  1279.     }
  1280.     if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {
  1281.         CloseHandle(startInfo.hStdOutput);
  1282.     }
  1283.     if (startInfo.hStdError != INVALID_HANDLE_VALUE) {
  1284.     CloseHandle(startInfo.hStdError);
  1285.     }
  1286.     return result;
  1287. }
  1288.  
  1289.  
  1290. /*
  1291.  *----------------------------------------------------------------------
  1292.  *
  1293.  * HasConsole --
  1294.  *
  1295.  *    Determines whether the current application is attached to a
  1296.  *    console.
  1297.  *
  1298.  * Results:
  1299.  *    Returns TRUE if this application has a console, else FALSE.
  1300.  *
  1301.  * Side effects:
  1302.  *    None.
  1303.  *
  1304.  *----------------------------------------------------------------------
  1305.  */
  1306.  
  1307. static BOOL
  1308. HasConsole()
  1309. {
  1310.     HANDLE handle = CreateFile("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
  1311.         NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
  1312.  
  1313.     if (handle != INVALID_HANDLE_VALUE) {
  1314.         CloseHandle(handle);
  1315.     return TRUE;
  1316.     } else {
  1317.         return FALSE;
  1318.     }
  1319. }
  1320.  
  1321. /*
  1322.  *--------------------------------------------------------------------
  1323.  *
  1324.  * ApplicationType --
  1325.  *
  1326.  *    Search for the specified program and identify if it refers to a DOS,
  1327.  *    Windows 3.X, or Win32 program.  Used to determine how to invoke 
  1328.  *    a program, or if it can even be invoked.
  1329.  *
  1330.  *    It is possible to almost positively identify DOS and Windows 
  1331.  *    applications that contain the appropriate magic numbers.  However, 
  1332.  *    DOS .com files do not seem to contain a magic number; if the program 
  1333.  *    name ends with .com and could not be identified as a Windows .com
  1334.  *    file, it will be assumed to be a DOS application, even if it was
  1335.  *    just random data.  If the program name does not end with .com, no 
  1336.  *    such assumption is made.
  1337.  *
  1338.  *    The Win32 procedure GetBinaryType incorrectly identifies any 
  1339.  *    junk file that ends with .exe as a dos executable and some 
  1340.  *    executables that don't end with .exe as not executable.  Plus it 
  1341.  *    doesn't exist under win95, so I won't feel bad about reimplementing
  1342.  *    functionality.
  1343.  *
  1344.  * Results:
  1345.  *    The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32
  1346.  *    if the filename referred to the corresponding application type.
  1347.  *    If the file name could not be found or did not refer to any known 
  1348.  *    application type, APPL_NONE is returned and an error message is 
  1349.  *    left in interp.  .bat files are identified as APPL_DOS.
  1350.  *
  1351.  * Side effects:
  1352.  *    None.
  1353.  *
  1354.  *----------------------------------------------------------------------
  1355.  */
  1356.  
  1357. static int
  1358. ApplicationType(interp, originalName, fullPath)
  1359.     Tcl_Interp *interp;        /* Interp, for error message. */
  1360.     const char *originalName;    /* Name of the application to find. */
  1361.     char fullPath[MAX_PATH];    /* Filled with complete path to 
  1362.                  * application. */
  1363. {
  1364.     int applType, i;
  1365.     HANDLE hFile;
  1366.     char *ext, *rest;
  1367.     char buf[2];
  1368.     DWORD read;
  1369.     IMAGE_DOS_HEADER header;
  1370.     static char extensions[][5] = {"", ".com", ".exe", ".bat"};
  1371.  
  1372.     /* Look for the program as an external program.  First try the name
  1373.      * as it is, then try adding .com, .exe, and .bat, in that order, to
  1374.      * the name, looking for an executable.
  1375.      *
  1376.      * Using the raw SearchPath() procedure doesn't do quite what is 
  1377.      * necessary.  If the name of the executable already contains a '.' 
  1378.      * character, it will not try appending the specified extension when
  1379.      * searching (in other words, SearchPath will not find the program 
  1380.      * "a.b.exe" if the arguments specified "a.b" and ".exe").   
  1381.      * So, first look for the file as it is named.  Then manually append 
  1382.      * the extensions, looking for a match.  
  1383.      */
  1384.  
  1385.     applType = APPL_NONE;
  1386.     for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
  1387.     lstrcpyn(fullPath, originalName, MAX_PATH - 5);
  1388.         lstrcat(fullPath, extensions[i]);
  1389.     
  1390.     SearchPath(NULL, fullPath, NULL, MAX_PATH, fullPath, &rest);
  1391.  
  1392.     /*
  1393.      * Ignore matches on directories or data files, return if identified
  1394.      * a known type.
  1395.      */
  1396.  
  1397.     if (GetFileAttributes(fullPath) & FILE_ATTRIBUTE_DIRECTORY) {
  1398.         continue;
  1399.     }
  1400.  
  1401.     ext = strrchr(fullPath, '.');
  1402.     if ((ext != NULL) && (strcmpi(ext, ".bat") == 0)) {
  1403.         applType = APPL_DOS;
  1404.         break;
  1405.     }
  1406.  
  1407.     hFile = CreateFile(fullPath, GENERIC_READ, FILE_SHARE_READ, NULL, 
  1408.         OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
  1409.     if (hFile == INVALID_HANDLE_VALUE) {
  1410.         continue;
  1411.     }
  1412.  
  1413.     header.e_magic = 0;
  1414.     ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
  1415.     if (header.e_magic != IMAGE_DOS_SIGNATURE) {
  1416.         /* 
  1417.          * Doesn't have the magic number for relocatable executables.  If 
  1418.          * filename ends with .com, assume it's a DOS application anyhow.
  1419.          * Note that we didn't make this assumption at first, because some
  1420.          * supposed .com files are really 32-bit executables with all the
  1421.          * magic numbers and everything.  
  1422.          */
  1423.  
  1424.         CloseHandle(hFile);
  1425.         if ((ext != NULL) && (strcmpi(ext, ".com") == 0)) {
  1426.         applType = APPL_DOS;
  1427.         break;
  1428.         }
  1429.         continue;
  1430.     }
  1431.     if (header.e_lfarlc != sizeof(header)) {
  1432.         /* 
  1433.          * All Windows 3.X and Win32 and some DOS programs have this value
  1434.          * set here.  If it doesn't, assume that since it already had the 
  1435.          * other magic number it was a DOS application.
  1436.          */
  1437.  
  1438.         CloseHandle(hFile);
  1439.         applType = APPL_DOS;
  1440.         break;
  1441.     }
  1442.  
  1443.     /* 
  1444.      * The DWORD at header.e_lfanew points to yet another magic number.
  1445.      */
  1446.  
  1447.     buf[0] = '\0';
  1448.     SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
  1449.     ReadFile(hFile, (void *) buf, 2, &read, NULL);
  1450.     CloseHandle(hFile);
  1451.  
  1452.     if ((buf[0] == 'L') && (buf[1] == 'E')) {
  1453.         applType = APPL_DOS;
  1454.     } else if ((buf[0] == 'N') && (buf[1] == 'E')) {
  1455.         applType = APPL_WIN3X;
  1456.     } else if ((buf[0] == 'P') && (buf[1] == 'E')) {
  1457.         applType = APPL_WIN32;
  1458.     } else {
  1459.         continue;
  1460.     }
  1461.     break;
  1462.     }
  1463.  
  1464.     if (applType == APPL_NONE) {
  1465.     TclWinConvertError(GetLastError());
  1466.     Tcl_AppendResult(interp, "couldn't execute \"", originalName,
  1467.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  1468.     return APPL_NONE;
  1469.     }
  1470.  
  1471.     if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
  1472.     /* 
  1473.      * Replace long path name of executable with short path name for 
  1474.      * 16-bit applications.  Otherwise the application may not be able
  1475.      * to correctly parse its own command line to separate off the 
  1476.      * application name from the arguments.
  1477.      */
  1478.  
  1479.     GetShortPathName(fullPath, fullPath, MAX_PATH);
  1480.     }
  1481.     return applType;
  1482. }
  1483.  
  1484. /*    
  1485.  *----------------------------------------------------------------------
  1486.  *
  1487.  * BuildCommandLine --
  1488.  *
  1489.  *    The command line arguments are stored in linePtr separated
  1490.  *    by spaces, in a form that CreateProcess() understands.  Special 
  1491.  *    characters in individual arguments from argv[] must be quoted 
  1492.  *    when being stored in cmdLine.
  1493.  *
  1494.  * Results:
  1495.  *    None.
  1496.  *
  1497.  * Side effects:
  1498.  *    None.
  1499.  *
  1500.  *----------------------------------------------------------------------
  1501.  */
  1502.  
  1503. static void
  1504. BuildCommandLine(argc, argv, linePtr)
  1505.     int argc;            /* Number of arguments. */
  1506.     char **argv;        /* Argument strings. */
  1507.     Tcl_DString *linePtr;    /* Initialized Tcl_DString that receives the
  1508.                  * command line. */
  1509. {
  1510.     char *start, *special;
  1511.     int quote, i;
  1512.  
  1513.     for (i = 0; i < argc; i++) {
  1514.     if (i > 0) {
  1515.         Tcl_DStringAppend(linePtr, " ", 1);    
  1516.     }
  1517.  
  1518.     quote = 0;
  1519.     for (start = argv[i]; *start != '\0'; start++) {
  1520.         if (isspace(*start)) {
  1521.         quote = 1;
  1522.         Tcl_DStringAppend(linePtr, "\"", 1);
  1523.             break;
  1524.         }
  1525.     }
  1526.  
  1527.     start = argv[i];        
  1528.     for (special = argv[i]; ; ) {
  1529.         if ((*special == '\\') && 
  1530.             (special[1] == '\\' || special[1] == '"')) {
  1531.         Tcl_DStringAppend(linePtr, start, special - start);
  1532.         start = special;
  1533.         while (1) {
  1534.             special++;
  1535.             if (*special == '"') {
  1536.             /* 
  1537.              * N backslashes followed a quote -> insert 
  1538.              * N * 2 + 1 backslashes then a quote.
  1539.              */
  1540.  
  1541.             Tcl_DStringAppend(linePtr, start, special - start);
  1542.             break;
  1543.             }
  1544.             if (*special != '\\') {
  1545.             break;
  1546.             }
  1547.         }
  1548.         Tcl_DStringAppend(linePtr, start, special - start);
  1549.         start = special;
  1550.         }
  1551.         if (*special == '"') {
  1552.         Tcl_DStringAppend(linePtr, start, special - start);
  1553.         Tcl_DStringAppend(linePtr, "\\\"", 2);
  1554.         start = special + 1;
  1555.         }
  1556.         if (*special == '\0') {
  1557.         break;
  1558.         }
  1559.         special++;
  1560.     }
  1561.     Tcl_DStringAppend(linePtr, start, special - start);
  1562.     if (quote) {
  1563.         Tcl_DStringAppend(linePtr, "\"", 1);
  1564.     }
  1565.     }
  1566. }
  1567.  
  1568. /*
  1569.  *----------------------------------------------------------------------
  1570.  *
  1571.  * MakeTempFile --
  1572.  *
  1573.  *    Helper function for TclpCreateProcess under Win32s.  Makes a 
  1574.  *    temporary file that _won't_ go away automatically when it's file
  1575.  *    handle is closed.  Used for simulated pipes, which are written
  1576.  *    in one pass and reopened and read in the next pass.
  1577.  *
  1578.  * Results:
  1579.  *    namePtr is filled with the name of the temporary file.
  1580.  *
  1581.  * Side effects:
  1582.  *    A temporary file with the name specified by namePtr is created.  
  1583.  *    The caller is responsible for deleting this temporary file.
  1584.  *
  1585.  *----------------------------------------------------------------------
  1586.  */
  1587.  
  1588. static char *
  1589. MakeTempFile(namePtr)
  1590.     Tcl_DString *namePtr;    /* Initialized Tcl_DString that is filled 
  1591.                  * with the name of the temporary file that 
  1592.                  * was created. */
  1593. {
  1594.     char name[MAX_PATH];
  1595.  
  1596.     if ((GetTempPath(MAX_PATH, name) == 0)
  1597.         || (GetTempFileName(name, "TCL", 0, name) == 0)) {
  1598.     return NULL;
  1599.     }
  1600.  
  1601.     Tcl_DStringAppend(namePtr, name, -1);
  1602.     return Tcl_DStringValue(namePtr);
  1603. }
  1604.  
  1605. /*
  1606.  *----------------------------------------------------------------------
  1607.  *
  1608.  * CopyChannel --
  1609.  *
  1610.  *    Helper function used by TclpCreateProcess under Win32s.  Copies
  1611.  *    what remains of source file to destination file; source file 
  1612.  *    pointer need not be positioned at the beginning of the file if
  1613.  *    all of source file is not desired, but data is copied up to end 
  1614.  *    of source file.
  1615.  *
  1616.  * Results:
  1617.  *    None.
  1618.  *
  1619.  * Side effects:
  1620.  *    None.
  1621.  *
  1622.  *----------------------------------------------------------------------
  1623.  */
  1624.  
  1625. static void
  1626. CopyChannel(dst, src)
  1627.     HANDLE dst;            /* Destination file. */
  1628.     HANDLE src;            /* Source file. */
  1629. {
  1630.     char buf[8192];
  1631.     DWORD dwRead, dwWrite;
  1632.  
  1633.     while (ReadFile(src, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
  1634.     if (dwRead == 0) {
  1635.         break;
  1636.     }
  1637.     if (WriteFile(dst, buf, dwRead, &dwWrite, NULL) == FALSE) {
  1638.         break;
  1639.     }
  1640.     }
  1641. }
  1642.  
  1643. /*
  1644.  *----------------------------------------------------------------------
  1645.  *
  1646.  * TclpCreateCommandChannel --
  1647.  *
  1648.  *    This function is called by Tcl_OpenCommandChannel to perform
  1649.  *    the platform specific channel initialization for a command
  1650.  *    channel.
  1651.  *
  1652.  * Results:
  1653.  *    Returns a new channel or NULL on failure.
  1654.  *
  1655.  * Side effects:
  1656.  *    Allocates a new channel.
  1657.  *
  1658.  *----------------------------------------------------------------------
  1659.  */
  1660.  
  1661. Tcl_Channel
  1662. TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
  1663.     TclFile readFile;        /* If non-null, gives the file for reading. */
  1664.     TclFile writeFile;        /* If non-null, gives the file for writing. */
  1665.     TclFile errorFile;        /* If non-null, gives the file where errors
  1666.                  * can be read. */
  1667.     int numPids;        /* The number of pids in the pid array. */
  1668.     Tcl_Pid *pidPtr;        /* An array of process identifiers. */
  1669. {
  1670.     char channelName[20];
  1671.     int channelId;
  1672.     PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
  1673.  
  1674.     infoPtr->watchMask = 0;
  1675.     infoPtr->flags = 0;
  1676.     infoPtr->readFile = readFile;
  1677.     infoPtr->writeFile = writeFile;
  1678.     infoPtr->errorFile = errorFile;
  1679.     infoPtr->numPids = numPids;
  1680.     infoPtr->pidPtr = pidPtr;
  1681.  
  1682.     /*
  1683.      * Use one of the fds associated with the channel as the
  1684.      * channel id.
  1685.      */
  1686.  
  1687.     if (readFile) {
  1688.     WinPipe *pipePtr = (WinPipe *) readFile;
  1689.     if (pipePtr->file.type == WIN32S_PIPE
  1690.         && pipePtr->file.handle == INVALID_HANDLE_VALUE) {
  1691.         pipePtr->file.handle = CreateFile(pipePtr->fileName, GENERIC_READ,
  1692.             0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
  1693.     }
  1694.     channelId = (int) pipePtr->file.handle;
  1695.     } else if (writeFile) {
  1696.     channelId = (int) ((WinFile*)writeFile)->handle;
  1697.     } else if (errorFile) {
  1698.     channelId = (int) ((WinFile*)errorFile)->handle;
  1699.     } else {
  1700.     channelId = 0;
  1701.     }
  1702.  
  1703.     infoPtr->validMask = 0;
  1704.     if (readFile != NULL) {
  1705.         infoPtr->validMask |= TCL_READABLE;
  1706.     }
  1707.     if (writeFile != NULL) {
  1708.         infoPtr->validMask |= TCL_WRITABLE;
  1709.     }
  1710.  
  1711.     /*
  1712.      * For backward compatibility with previous versions of Tcl, we
  1713.      * use "file%d" as the base name for pipes even though it would
  1714.      * be more natural to use "pipe%d".
  1715.      */
  1716.  
  1717.     sprintf(channelName, "file%d", channelId);
  1718.     infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
  1719.             (ClientData) infoPtr, infoPtr->validMask);
  1720.  
  1721.     /*
  1722.      * Pipes have AUTO translation mode on Windows and ^Z eof char, which
  1723.      * means that a ^Z will be appended to them at close. This is needed
  1724.      * for Windows programs that expect a ^Z at EOF.
  1725.      */
  1726.  
  1727.     Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
  1728.         "-translation", "auto");
  1729.     Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
  1730.         "-eofchar", "\032 {}");
  1731.     return infoPtr->channel;
  1732. }
  1733.  
  1734. /*
  1735.  *----------------------------------------------------------------------
  1736.  *
  1737.  * TclGetAndDetachPids --
  1738.  *
  1739.  *    Stores a list of the command PIDs for a command channel in
  1740.  *    interp->result.
  1741.  *
  1742.  * Results:
  1743.  *    None.
  1744.  *
  1745.  * Side effects:
  1746.  *    Modifies interp->result.
  1747.  *
  1748.  *----------------------------------------------------------------------
  1749.  */
  1750.  
  1751. void
  1752. TclGetAndDetachPids(interp, chan)
  1753.     Tcl_Interp *interp;
  1754.     Tcl_Channel chan;
  1755. {
  1756.     PipeInfo *pipePtr;
  1757.     Tcl_ChannelType *chanTypePtr;
  1758.     int i;
  1759.     char buf[20];
  1760.  
  1761.     /*
  1762.      * Punt if the channel is not a command channel.
  1763.      */
  1764.  
  1765.     chanTypePtr = Tcl_GetChannelType(chan);
  1766.     if (chanTypePtr != &pipeChannelType) {
  1767.         return;
  1768.     }
  1769.  
  1770.     pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
  1771.     for (i = 0; i < pipePtr->numPids; i++) {
  1772.         sprintf(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
  1773.         Tcl_AppendElement(interp, buf);
  1774.         Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
  1775.     }
  1776.     if (pipePtr->numPids > 0) {
  1777.         ckfree((char *) pipePtr->pidPtr);
  1778.         pipePtr->numPids = 0;
  1779.     }
  1780. }
  1781.  
  1782. /*
  1783.  *----------------------------------------------------------------------
  1784.  *
  1785.  * PipeBlockModeProc --
  1786.  *
  1787.  *    Set blocking or non-blocking mode on channel.
  1788.  *
  1789.  * Results:
  1790.  *    0 if successful, errno when failed.
  1791.  *
  1792.  * Side effects:
  1793.  *    Sets the device into blocking or non-blocking mode.
  1794.  *
  1795.  *----------------------------------------------------------------------
  1796.  */
  1797.  
  1798. static int
  1799. PipeBlockModeProc(instanceData, mode)
  1800.     ClientData instanceData;    /* Instance data for channel. */
  1801.     int mode;            /* TCL_MODE_BLOCKING or
  1802.                                  * TCL_MODE_NONBLOCKING. */
  1803. {
  1804.     PipeInfo *infoPtr = (PipeInfo *) instanceData;
  1805.     
  1806.     /*
  1807.      * Pipes on Windows can not be switched between blocking and nonblocking,
  1808.      * hence we have to emulate the behavior. This is done in the input
  1809.      * function by checking against a bit in the state. We set or unset the
  1810.      * bit here to cause the input function to emulate the correct behavior.
  1811.      */
  1812.  
  1813.     if (mode == TCL_MODE_NONBLOCKING) {
  1814.     infoPtr->flags |= PIPE_ASYNC;
  1815.     } else {
  1816.     infoPtr->flags &= ~(PIPE_ASYNC);
  1817.     }
  1818.     return 0;
  1819. }
  1820.  
  1821. /*
  1822.  *----------------------------------------------------------------------
  1823.  *
  1824.  * PipeCloseProc --
  1825.  *
  1826.  *    Closes a pipe based IO channel.
  1827.  *
  1828.  * Results:
  1829.  *    0 on success, errno otherwise.
  1830.  *
  1831.  * Side effects:
  1832.  *    Closes the physical channel.
  1833.  *
  1834.  *----------------------------------------------------------------------
  1835.  */
  1836.  
  1837. static int
  1838. PipeCloseProc(instanceData, interp)
  1839.     ClientData instanceData;    /* Pointer to PipeInfo structure. */
  1840.     Tcl_Interp *interp;        /* For error reporting. */
  1841. {
  1842.     PipeInfo *pipePtr = (PipeInfo *) instanceData;
  1843.     Tcl_Channel errChan;
  1844.     int errorCode, result;
  1845.     PipeInfo *infoPtr, **nextPtrPtr;
  1846.  
  1847.     /*
  1848.      * Remove the file from the list of watched files.
  1849.      */
  1850.  
  1851.     for (nextPtrPtr = &firstPipePtr, infoPtr = *nextPtrPtr; infoPtr != NULL;
  1852.         nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
  1853.     if (infoPtr == (PipeInfo *)pipePtr) {
  1854.         *nextPtrPtr = infoPtr->nextPtr;
  1855.         break;
  1856.     }
  1857.     }
  1858.  
  1859.     errorCode = 0;
  1860.     if (pipePtr->readFile != NULL) {
  1861.     if (TclpCloseFile(pipePtr->readFile) != 0) {
  1862.         errorCode = errno;
  1863.     }
  1864.     }
  1865.     if (pipePtr->writeFile != NULL) {
  1866.     if (TclpCloseFile(pipePtr->writeFile) != 0) {
  1867.         if (errorCode == 0) {
  1868.         errorCode = errno;
  1869.         }
  1870.     }
  1871.     }
  1872.     
  1873.     /*
  1874.      * Wrap the error file into a channel and give it to the cleanup
  1875.      * routine.  If we are running in Win32s, just delete the error file
  1876.      * immediately, because it was never used.
  1877.      */
  1878.  
  1879.     if (pipePtr->errorFile) {
  1880.     WinFile *filePtr;
  1881.     OSVERSIONINFO os;
  1882.  
  1883.     os.dwOSVersionInfoSize = sizeof(os);
  1884.     GetVersionEx(&os);
  1885.     if (os.dwPlatformId == VER_PLATFORM_WIN32s) {
  1886.         TclpCloseFile(pipePtr->errorFile);
  1887.         errChan = NULL;
  1888.     } else {
  1889.         filePtr = (WinFile*)pipePtr->errorFile;
  1890.         errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
  1891.             TCL_READABLE);
  1892.     }
  1893.     } else {
  1894.         errChan = NULL;
  1895.     }
  1896.     result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
  1897.             errChan);
  1898.     if (pipePtr->numPids > 0) {
  1899.         ckfree((char *) pipePtr->pidPtr);
  1900.     }
  1901.     ckfree((char*) pipePtr);
  1902.  
  1903.     if (errorCode == 0) {
  1904.         return result;
  1905.     }
  1906.     return errorCode;
  1907. }
  1908.  
  1909. /*
  1910.  *----------------------------------------------------------------------
  1911.  *
  1912.  * PipeInputProc --
  1913.  *
  1914.  *    Reads input from the IO channel into the buffer given. Returns
  1915.  *    count of how many bytes were actually read, and an error indication.
  1916.  *
  1917.  * Results:
  1918.  *    A count of how many bytes were read is returned and an error
  1919.  *    indication is returned in an output argument.
  1920.  *
  1921.  * Side effects:
  1922.  *    Reads input from the actual channel.
  1923.  *
  1924.  *----------------------------------------------------------------------
  1925.  */
  1926.  
  1927. static int
  1928. PipeInputProc(instanceData, buf, bufSize, errorCode)
  1929.     ClientData instanceData;        /* Pipe state. */
  1930.     char *buf;                /* Where to store data read. */
  1931.     int bufSize;            /* How much space is available
  1932.                                          * in the buffer? */
  1933.     int *errorCode;            /* Where to store error code. */
  1934. {
  1935.     PipeInfo *infoPtr = (PipeInfo *) instanceData;
  1936.     WinFile *filePtr = (WinFile*) infoPtr->readFile;
  1937.     DWORD count;
  1938.     DWORD bytesRead;
  1939.  
  1940.     *errorCode = 0;
  1941.     if (filePtr->type == WIN32S_PIPE) {
  1942.     if (((WinPipe *)filePtr)->otherPtr != NULL) {
  1943.         panic("PipeInputProc: child process isn't finished writing");
  1944.     }
  1945.     if (filePtr->handle == INVALID_HANDLE_VALUE) {
  1946.         filePtr->handle = CreateFile(((WinPipe *)filePtr)->fileName,
  1947.             GENERIC_READ, 0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL,
  1948.             NULL);
  1949.     }
  1950.     if (filePtr->handle == INVALID_HANDLE_VALUE) {
  1951.         goto error;
  1952.     }
  1953.     } else {
  1954.     /*
  1955.      * Pipes will block until the requested number of bytes has been
  1956.      * read.  To avoid blocking unnecessarily, we look ahead and only
  1957.      * read as much as is available.
  1958.      */
  1959.  
  1960.     if (PeekNamedPipe(filePtr->handle, (LPVOID) NULL, (DWORD) 0,
  1961.         (LPDWORD) NULL, &count, (LPDWORD) NULL) == TRUE) {
  1962.         if ((count != 0) && ((DWORD) bufSize > count)) {
  1963.         bufSize = (int) count;
  1964.  
  1965.         /*
  1966.          * This code is commented out because on Win95 we don't get
  1967.          * notifier of eof on a pipe unless we try to read it.
  1968.          * The correct solution is to move to threads.
  1969.          */
  1970.  
  1971. /*         } else if ((count == 0) && (infoPtr->flags & PIPE_ASYNC)) { */
  1972. /*         errno = *errorCode = EAGAIN; */
  1973. /*         return -1; */
  1974.         } else if ((count == 0) && !(infoPtr->flags & PIPE_ASYNC)) {
  1975.         bufSize = 1;
  1976.         }
  1977.     } else {
  1978.         goto error;
  1979.     }
  1980.     }
  1981.  
  1982.     /*
  1983.      * Note that we will block on reads from a console buffer until a
  1984.      * full line has been entered.  The only way I know of to get
  1985.      * around this is to write a console driver.  We should probably
  1986.      * do this at some point, but for now, we just block.
  1987.      */
  1988.  
  1989.     if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
  1990.             (LPOVERLAPPED) NULL) == FALSE) {
  1991.     goto error;
  1992.     }
  1993.     
  1994.     return bytesRead;
  1995.  
  1996.     error:
  1997.     TclWinConvertError(GetLastError());
  1998.     if (errno == EPIPE) {
  1999.     return 0;
  2000.     }
  2001.     *errorCode = errno;
  2002.     return -1;
  2003. }
  2004.  
  2005. /*
  2006.  *----------------------------------------------------------------------
  2007.  *
  2008.  * PipeOutputProc --
  2009.  *
  2010.  *    Writes the given output on the IO channel. Returns count of how
  2011.  *    many characters were actually written, and an error indication.
  2012.  *
  2013.  * Results:
  2014.  *    A count of how many characters were written is returned and an
  2015.  *    error indication is returned in an output argument.
  2016.  *
  2017.  * Side effects:
  2018.  *    Writes output on the actual channel.
  2019.  *
  2020.  *----------------------------------------------------------------------
  2021.  */
  2022.  
  2023. static int
  2024. PipeOutputProc(instanceData, buf, toWrite, errorCode)
  2025.     ClientData instanceData;        /* Pipe state. */
  2026.     char *buf;                /* The data buffer. */
  2027.     int toWrite;            /* How many bytes to write? */
  2028.     int *errorCode;            /* Where to store error code. */
  2029. {
  2030.     PipeInfo *infoPtr = (PipeInfo *) instanceData;
  2031.     WinFile *filePtr = (WinFile*) infoPtr->writeFile;
  2032.     DWORD bytesWritten;
  2033.     
  2034.     *errorCode = 0;
  2035.     if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
  2036.         &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
  2037.         TclWinConvertError(GetLastError());
  2038.         if (errno == EPIPE) {
  2039.             return 0;
  2040.         }
  2041.         *errorCode = errno;
  2042.         return -1;
  2043.     }
  2044.     return bytesWritten;
  2045. }
  2046.  
  2047. /*
  2048.  *----------------------------------------------------------------------
  2049.  *
  2050.  * PipeEventProc --
  2051.  *
  2052.  *    This function is invoked by Tcl_ServiceEvent when a file event
  2053.  *    reaches the front of the event queue.  This procedure invokes
  2054.  *    Tcl_NotifyChannel on the pipe.
  2055.  *
  2056.  * Results:
  2057.  *    Returns 1 if the event was handled, meaning it should be removed
  2058.  *    from the queue.  Returns 0 if the event was not handled, meaning
  2059.  *    it should stay on the queue.  The only time the event isn't
  2060.  *    handled is if the TCL_FILE_EVENTS flag bit isn't set.
  2061.  *
  2062.  * Side effects:
  2063.  *    Whatever the notifier callback does.
  2064.  *
  2065.  *----------------------------------------------------------------------
  2066.  */
  2067.  
  2068. static int
  2069. PipeEventProc(evPtr, flags)
  2070.     Tcl_Event *evPtr;        /* Event to service. */
  2071.     int flags;            /* Flags that indicate what events to
  2072.                  * handle, such as TCL_FILE_EVENTS. */
  2073. {
  2074.     PipeEvent *pipeEvPtr = (PipeEvent *)evPtr;
  2075.     PipeInfo *infoPtr;
  2076.     WinFile *filePtr;
  2077.     int mask;
  2078. /*    DWORD count;*/
  2079.  
  2080.     if (!(flags & TCL_FILE_EVENTS)) {
  2081.     return 0;
  2082.     }
  2083.  
  2084.     /*
  2085.      * Search through the list of watched pipes for the one whose handle
  2086.      * matches the event.  We do this rather than simply dereferencing
  2087.      * the handle in the event so that pipes can be deleted while the
  2088.      * event is in the queue.
  2089.      */
  2090.  
  2091.     for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  2092.     if (pipeEvPtr->infoPtr == infoPtr) {
  2093.         infoPtr->flags &= ~(PIPE_PENDING);
  2094.         break;
  2095.     }
  2096.     }
  2097.  
  2098.     /*
  2099.      * Remove stale events.
  2100.      */
  2101.  
  2102.     if (!infoPtr) {
  2103.     return 1;
  2104.     }
  2105.  
  2106.     /*
  2107.      * If we aren't on Win32s, check to see if the pipe is readable.  Note
  2108.      * that we can't tell if a pipe is writable, so we always report it
  2109.      * as being writable.
  2110.      */
  2111.  
  2112.     filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile;
  2113.     if (filePtr->type != WIN32S_PIPE) {
  2114.  
  2115.     /*
  2116.      * On windows 95, PeekNamedPipe returns 0 on eof so we can't
  2117.      * distinguish underflow from eof.  The correct solution is to
  2118.      * switch to the threaded implementation.
  2119.      */
  2120.     mask = TCL_WRITABLE|TCL_READABLE;
  2121. /*     if (PeekNamedPipe(filePtr->handle, (LPVOID) NULL, (DWORD) 0, */
  2122. /*         (LPDWORD) NULL, &count, (LPDWORD) NULL) == TRUE) { */
  2123. /*         if (count != 0) { */
  2124. /*         mask |= TCL_READABLE; */
  2125. /*         } */
  2126. /*     } else { */
  2127.  
  2128.         /*
  2129.          * If the pipe has been closed by the other side, then 
  2130.          * mark the pipe as readable, but not writable.
  2131.          */
  2132.  
  2133. /*         if (GetLastError() == ERROR_BROKEN_PIPE) { */
  2134. /*         mask = TCL_READABLE; */
  2135. /*         } */
  2136. /*     } */
  2137.     } else {
  2138.     mask = TCL_READABLE | TCL_WRITABLE;
  2139.     }
  2140.  
  2141.     /*
  2142.      * Inform the channel of the events.
  2143.      */
  2144.  
  2145.     Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
  2146.     return 1;
  2147. }
  2148.  
  2149. /*
  2150.  *----------------------------------------------------------------------
  2151.  *
  2152.  * PipeWatchProc --
  2153.  *
  2154.  *    Called by the notifier to set up to watch for events on this
  2155.  *    channel.
  2156.  *
  2157.  * Results:
  2158.  *    None.
  2159.  *
  2160.  * Side effects:
  2161.  *    None.
  2162.  *
  2163.  *----------------------------------------------------------------------
  2164.  */
  2165.  
  2166. static void
  2167. PipeWatchProc(instanceData, mask)
  2168.     ClientData instanceData;        /* Pipe state. */
  2169.     int mask;                /* What events to watch for; OR-ed
  2170.                                          * combination of TCL_READABLE,
  2171.                                          * TCL_WRITABLE and TCL_EXCEPTION. */
  2172. {
  2173.     PipeInfo **nextPtrPtr, *ptr;
  2174.     PipeInfo *infoPtr = (PipeInfo *) instanceData;
  2175.     int oldMask = infoPtr->watchMask;
  2176.  
  2177.     if (!initialized) {
  2178.     PipeInit();
  2179.     }
  2180.  
  2181.     /*
  2182.      * For now, we just send a message to ourselves so we can poll the
  2183.      * channel for readable events.
  2184.      */
  2185.  
  2186.     infoPtr->watchMask = mask & infoPtr->validMask;
  2187.     if (infoPtr->watchMask) {
  2188.     Tcl_Time blockTime = { 0, 0 };
  2189.     if (!oldMask) {
  2190.         infoPtr->nextPtr = firstPipePtr;
  2191.         firstPipePtr = infoPtr;
  2192.     }
  2193.     Tcl_SetMaxBlockTime(&blockTime);
  2194.     } else {
  2195.     if (oldMask) {
  2196.         /*
  2197.          * Remove the pipe from the list of watched pipes.
  2198.          */
  2199.  
  2200.         for (nextPtrPtr = &firstPipePtr, ptr = *nextPtrPtr;
  2201.          ptr != NULL;
  2202.          nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
  2203.         if (infoPtr == ptr) {
  2204.             *nextPtrPtr = ptr->nextPtr;
  2205.             break;
  2206.         }
  2207.         }
  2208.     }
  2209.     }
  2210. }
  2211.  
  2212. /*
  2213.  *----------------------------------------------------------------------
  2214.  *
  2215.  * PipeGetHandleProc --
  2216.  *
  2217.  *    Called from Tcl_GetChannelHandle to retrieve OS handles from
  2218.  *    inside a command pipeline based channel.
  2219.  *
  2220.  * Results:
  2221.  *    Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
  2222.  *    there is no handle for the specified direction. 
  2223.  *
  2224.  * Side effects:
  2225.  *    None.
  2226.  *
  2227.  *----------------------------------------------------------------------
  2228.  */
  2229.  
  2230. static int
  2231. PipeGetHandleProc(instanceData, direction, handlePtr)
  2232.     ClientData instanceData;    /* The pipe state. */
  2233.     int direction;        /* TCL_READABLE or TCL_WRITABLE */
  2234.     ClientData *handlePtr;    /* Where to store the handle.  */
  2235. {
  2236.     PipeInfo *infoPtr = (PipeInfo *) instanceData;
  2237.     WinFile *filePtr; 
  2238.  
  2239.     if (direction == TCL_READABLE && infoPtr->readFile) {
  2240.     filePtr = (WinFile*) infoPtr->readFile;
  2241.     if (filePtr->type == WIN32S_PIPE) {
  2242.         if (filePtr->handle == INVALID_HANDLE_VALUE) {
  2243.         filePtr->handle = CreateFile(((WinPipe *)filePtr)->fileName,
  2244.             GENERIC_READ, 0, NULL, OPEN_ALWAYS,
  2245.             FILE_ATTRIBUTE_NORMAL, NULL);
  2246.         }
  2247.         if (filePtr->handle == INVALID_HANDLE_VALUE) {
  2248.         return TCL_ERROR;
  2249.         }
  2250.     }
  2251.     *handlePtr = (ClientData) filePtr->handle;
  2252.     return TCL_OK;
  2253.     }
  2254.     if (direction == TCL_WRITABLE && infoPtr->writeFile) {
  2255.     filePtr = (WinFile*) infoPtr->writeFile;
  2256.     *handlePtr = (ClientData) filePtr->handle;
  2257.     return TCL_OK;
  2258.     }
  2259.     return TCL_ERROR;
  2260. }
  2261.  
  2262. /*
  2263.  *----------------------------------------------------------------------
  2264.  *
  2265.  * Tcl_WaitPid --
  2266.  *
  2267.  *    Emulates the waitpid system call.
  2268.  *
  2269.  * Results:
  2270.  *    Returns 0 if the process is still alive, -1 on an error, or
  2271.  *    the pid on a clean close.  
  2272.  *
  2273.  * Side effects:
  2274.  *    Unless WNOHANG is set and the wait times out, the process
  2275.  *    information record will be deleted and the process handle
  2276.  *    will be closed.
  2277.  *
  2278.  *----------------------------------------------------------------------
  2279.  */
  2280.  
  2281. Tcl_Pid
  2282. Tcl_WaitPid(pid, statPtr, options)
  2283.     Tcl_Pid pid;
  2284.     int *statPtr;
  2285.     int options;
  2286. {
  2287.     ProcInfo *infoPtr, **prevPtrPtr;
  2288.     int flags;
  2289.     Tcl_Pid result;
  2290.     DWORD ret;
  2291.  
  2292.     if (options & WNOHANG) {
  2293.     flags = 0;
  2294.     } else {
  2295.     flags = INFINITE;
  2296.     }
  2297.     if (pid == 0) {
  2298.     *statPtr = 0;
  2299.     return 0;
  2300.     }
  2301.  
  2302.     /*
  2303.      * Find the process on the process list.
  2304.      */
  2305.  
  2306.     prevPtrPtr = &procList;
  2307.     for (infoPtr = procList; infoPtr != NULL;
  2308.         prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
  2309.      if (infoPtr->hProcess == (HANDLE) pid) {
  2310.         break;
  2311.     }
  2312.     }
  2313.     if (infoPtr == NULL) {
  2314.     return 0;
  2315.     }
  2316.  
  2317.     ret = WaitForSingleObject(infoPtr->hProcess, flags);
  2318.     if (ret == WAIT_TIMEOUT) {
  2319.     *statPtr = 0;
  2320.     if (options & WNOHANG) {
  2321.         return 0;
  2322.     } else {
  2323.         result = 0;
  2324.     }
  2325.     } else if (ret != WAIT_FAILED) {
  2326.     GetExitCodeProcess(infoPtr->hProcess, (DWORD*)statPtr);
  2327.     *statPtr = ((*statPtr << 8) & 0xff00);
  2328.     result = pid;
  2329.     } else {
  2330.     errno = ECHILD;
  2331.     result = (Tcl_Pid) -1;
  2332.     }
  2333.  
  2334.     /*
  2335.      * Remove the process from the process list and close the process handle.
  2336.      */
  2337.     CloseHandle(infoPtr->hProcess);
  2338.     *prevPtrPtr = infoPtr->nextPtr;
  2339.     ckfree((char*)infoPtr);
  2340.  
  2341.     return result;
  2342. }
  2343.  
  2344. /*
  2345.  *----------------------------------------------------------------------
  2346.  *
  2347.  * Tcl_PidObjCmd --
  2348.  *
  2349.  *    This procedure is invoked to process the "pid" Tcl command.
  2350.  *    See the user documentation for details on what it does.
  2351.  *
  2352.  * Results:
  2353.  *    A standard Tcl result.
  2354.  *
  2355.  * Side effects:
  2356.  *    See the user documentation.
  2357.  *
  2358.  *----------------------------------------------------------------------
  2359.  */
  2360.  
  2361.     /* ARGSUSED */
  2362. int
  2363. Tcl_PidObjCmd(dummy, interp, objc, objv)
  2364.     ClientData dummy;        /* Not used. */
  2365.     Tcl_Interp *interp;        /* Current interpreter. */
  2366.     int objc;            /* Number of arguments. */
  2367.     Tcl_Obj *CONST *objv;    /* Argument strings. */
  2368. {
  2369.     Tcl_Channel chan;
  2370.     Tcl_ChannelType *chanTypePtr;
  2371.     PipeInfo *pipePtr;
  2372.     int i;
  2373.     Tcl_Obj *resultPtr;
  2374.     char buf[20];
  2375.  
  2376.     if (objc > 2) {
  2377.     Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
  2378.     return TCL_ERROR;
  2379.     }
  2380.     if (objc == 1) {
  2381.     resultPtr = Tcl_GetObjResult(interp);
  2382.     sprintf(buf, "%lu", (unsigned long) getpid());
  2383.     Tcl_SetStringObj(resultPtr, buf, -1);
  2384.     } else {
  2385.         chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
  2386.         NULL);
  2387.         if (chan == (Tcl_Channel) NULL) {
  2388.         return TCL_ERROR;
  2389.     }
  2390.     chanTypePtr = Tcl_GetChannelType(chan);
  2391.     if (chanTypePtr != &pipeChannelType) {
  2392.         return TCL_OK;
  2393.     }
  2394.  
  2395.         pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
  2396.     resultPtr = Tcl_GetObjResult(interp);
  2397.         for (i = 0; i < pipePtr->numPids; i++) {
  2398.         sprintf(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
  2399.         Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
  2400.             Tcl_NewStringObj(buf, -1));
  2401.     }
  2402.     }
  2403.     return TCL_OK;
  2404. }
  2405.